%%%-------------------------------------------------------------------
%%% File    : ewgib_api.erl
%%% Authors : Filippo Pacini <pacini@sgconsulting.it>
%%%           Hunter Morris <huntermorris@gmail.com>
%%% License :
%%% The contents of this file are subject to the Mozilla Public
%%% License Version 1.1 (the "License"); you may not use this file
%%% except in compliance with the License. You may obtain a copy of
%%% the License at http://www.mozilla.org/MPL/
%%%
%%% Software distributed under the License is distributed on an "AS IS"
%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%%% the License for the specific language governing rights and
%%% limitations under the License.
%%% The Initial Developer of the Original Code is S.G. Consulting
%%% srl. Portions created by S.G. Consulting s.r.l. are Copyright (C)
%%% 2007 S.G. Consulting srl. All Rights Reserved.
%%%
%%% @doc 
%%% <p>ewgi API. Defines a low level CGI like API.</p>
%%%
%%% @end
%%%
%%% Created : 10 Oct 2007 by Filippo Pacini <pacini@sgconsulting.it>
%%%-------------------------------------------------------------------
-module(ewgi_api).

%% API
-export([server_sw/1,
         server_name/1,
         gw_interface/1,
         server_protocol/1,
         server_port/1,
         method/1,
         path_info/1,
         path_translated/1,
         script_name/1,
         qs/1,
         content_type/1,
         content_length/1,
         remote_host/1,
         remote_addr/1,
         auth_type/1,
         remote_user/1,
         remote_ident/1,
         get_all_headers/1,
         get_value/2,
         get_value/3,
         get_all_values/2,
         set_value/3,
         parse_qs/1,
         parse_post/1,
         parse_data/1,
         urlencode/1,
         quote/1,
         unquote/1,
         read_input/3,
         write_error/2,
         normalize_header/1,
         url_scheme/1,
         version/1,
         get_all_data/1,
         get_data/2,
         add_data/3,
         replace_data/2,
         unquote_path/1
        ]).

%%====================================================================
%% API
%%====================================================================
server_sw(Env) ->
    proplists:get_value("SERVER_SOFTWARE", Env).

server_name(Env) ->
    proplists:get_value("SERVER_NAME", Env).

gw_interface(Env) ->
    proplists:get_value("GATEWAY_INTERFACE", Env).

server_protocol(Env) ->
    proplists:get_value("SERVER_PROTOCOL", Env).

server_port(Env) ->
    proplists:get_value("SERVER_PORT", Env).

method(Env) ->
    proplists:get_value("REQUEST_METHOD", Env).

path_info(Env) ->
    proplists:get_value("PATH_INFO", Env).

path_translated(Env) ->
    proplists:get_value("PATH_TRANSLATED", Env).

script_name(Env) ->
    proplists:get_value("SCRIPT_NAME", Env).

qs(Env) ->
    proplists:get_value("QUERY_STRING", Env).

content_type(Env) ->
    proplists:get_value("CONTENT_TYPE", Env).

content_length(Env) ->
    proplists:get_value("CONTENT_LENGTH", Env).

remote_host(Env) ->
    proplists:get_value("REMOTE_HOST", Env).

remote_addr(Env) ->
    proplists:get_value("REMOTE_ADDR", Env).

auth_type(Env) ->
    proplists:get_value("AUTH_TYPE", Env).

remote_user(Env) ->
    proplists:get_value("REMOTE_USER", Env).

remote_ident(Env) ->
    proplists:get_value("REMOTE_IDENT", Env).

get_all_headers(Env) ->
    lists:foldl(fun({"HTTP_" ++ _, _}=Pair, Hdrs) ->
                        [Pair|Hdrs];
                   (_, Hdrs) ->
                        Hdrs
                end, [], Env).

get_value(Key, Env) ->
    proplists:get_value(Key, Env).

get_value(Key, Env, Default) ->
    proplists:get_value(Key, Env, Default).

get_all_values(Key, Env) ->
    proplists:get_all_values(Key, Env).

set_value(Key, Val, Env) ->
    lists:keyreplace(Key, 1, Env, {Key, Val}).

read_input(Callback, Length, Env) ->
    F = proplists:get_value("ewgi.read_input", Env),
    F(Callback, Length).

write_error(Msg, Env) ->
    F = proplists:get_value("ewgi.write_error", Env),
    F(Msg).

url_scheme(Env) ->
    proplists:get_value("ewgi.url_scheme", Env).

version(Env) ->
    proplists:get_value("ewgi.version", Env).

get_all_data(Env) ->
    proplists:get_value("ewgi.data", Env).

get_data(Key, Env) ->
    proplists:get_value(Key, proplists:get_value("ewgi.data", Env)).

add_data(Key, Val, Env) ->
    Data = proplists:get_value("ewgi.data", Env),
    ?MODULE:set_value("ewgi.data", [proplists:property(Key, Val)|Data], Env).

replace_data(Data, Env) ->
    ?MODULE:set_value("ewgi.data", Data, Env).
    
%%--------------------------------------------------------------------
%% @spec parse_qs(string()|binary()) -> [proplist()]
%%
%% @doc Parse a query string. Calls parse_data to do the job.
%% @end
%%--------------------------------------------------------------------
parse_qs(ToParse) ->
    parse_data(ToParse).

%%--------------------------------------------------------------------
%% @spec parse_post(string()|binary()) -> [proplist()]
%%
%% @doc Parse application/x-www-form-urlencoded data. 
%% Calls parse_data to do the job.
%% @end
%%--------------------------------------------------------------------
parse_post(ToParse) ->
    parse_data(ToParse).

%%--------------------------------------------------------------------
%% @spec parse_data(string()|binary()) -> [proplist()]
%%
%% @doc Parse a query string or application/x-www-form-urlencoded data.
%% @end
%%--------------------------------------------------------------------
parse_data(undefined) ->
    [];
parse_data(Binary) when is_binary(Binary) ->
    parse_data(binary_to_list(Binary), []);
parse_data(String) ->
    parse_data(String, []).

parse_data([], Acc) ->
    lists:reverse(Acc);
parse_data(String, Acc) ->
    {{Key, Val}, Rest} = parse_kv(String),
    parse_data(Rest, [{Key, Val} | Acc]).


%%--------------------------------------------------------------------
%% @spec urlencode(proplist()) -> string()
%%
%% @doc URL encodes a proplist of parameters.
%% @end
%%--------------------------------------------------------------------
urlencode(Props) ->
    QuotedL = lists:foldl(fun({K, V}, AccIn) ->
                                  [[quote(K), $=, quote(V)] | AccIn]
                          end, [], Props),
    lists:flatten(join(QuotedL, $&)).

%%--------------------------------------------------------------------
%% @spec quote(term()) -> string()
%%
%% @doc URL encodes the given term.
%% @end
%%--------------------------------------------------------------------
quote(Term) when is_atom(Term) ->
    quote(atom_to_list(Term));
quote(Term) when is_integer(Term) ->
    quote(integer_to_list(Term));
quote(Term) ->
    quote(Term, []).

quote([], Acc) ->
    lists:reverse(Acc);
%% low alpha chars
quote([H|Rest], Acc) when H >= $a andalso H =< $z ->
    quote(Rest, [H|Acc]);
%% hialpha chars 
quote([H|Rest], Acc) when H >= $A andalso H =< $Z ->
    quote(Rest, [H|Acc]);
%% digit chars
quote([H|Rest], Acc) when H >= $0 andalso H =< $9 ->
    quote(Rest, [H|Acc]);
%% safe chars
quote([H|Rest], Acc) when H =:= $- orelse H=:=$. orelse H=:=$_  orelse H=:=$~ ->
    quote(Rest, [H|Acc]);
%% space
quote([$\s|Rest], Acc) ->
    quote(Rest, [$+ | Acc]);
%% other characters (convert to hex)
quote([H|Rest], Acc) ->
    <<Hi:4, Lo:4>> = <<H>>,
    quote(Rest, [to_hex(Lo), to_hex(Hi), $\% | Acc]).


%%====================================================================
%% Internal functions
%%====================================================================
%%--------------------------------------------------------------------
%% @spec parse_kv(String::string()) -> parsed()|{error, Reason}
%%
%% @type parsed() = {ok, proplist(), Rest::string()}
%%
%% @doc Parser for kv pairs found in query strings and body data.
%% returns the first proplist parsed from String or an error. 
%% @end
%%--------------------------------------------------------------------
parse_kv(String) ->
    P = and_parser([until(fun is_equal/1), until(fun is_amp/1)]),
    case P(String) of
        {ok, [K, V], Rest} ->
            {{unquote(K), unquote(V)}, Rest};
        {error, Reason} -> {error, Reason}
    end.

%%--------------------------------------------------------------------
%% @spec and_parser(Rules::rules()) -> parsed()|{error, Reason}
%%
%% @type rules() = [rule()]
%%       rule()  = function(template()).
%%
%% @doc and_parser of Rules. 
%% Applies each Rule in sequence to the Template passed. 
%% If a rule fails returns an error.
%% @end
%%--------------------------------------------------------------------
and_parser(Rules) ->
    fun(Tmpl) ->
	    and_parser(Rules, Tmpl, [])
    end.
and_parser([], Tmpl, SoFar) ->
    {ok, lists:reverse(SoFar), Tmpl};
and_parser([Rule|T], Tmpl, SoFar) ->
    case Rule(Tmpl) of
	{error, Reason} ->
	    {error, Reason};
	{ok, Rest} ->
	    and_parser(T, Rest, SoFar);
	{ok, Tok, Rest} ->
	    and_parser(T, Rest, [Tok|SoFar])
    end.

%%--------------------------------------------------------------------
%% @spec until(predicate()) -> parsed()|{error, Reason}
%%
%% @type predicate() = function(template()).
%%
%% @doc until predicate P: 
%% output what it gets until P(H) is true.
%% @end
%%--------------------------------------------------------------------
until(P) ->
    fun (Tmpl) -> until(P, Tmpl, []) end.
until(_P, [], Parsed) -> %% end of string so end parsing
    {ok, lists:reverse(Parsed), []};
until(P, String, Parsed) ->
    case P(String) of
	{true, Rest} ->
	    {ok, lists:reverse(Parsed), Rest};
	_ ->
            [H|Rest] = String,
	    until(P, Rest, [H|Parsed])
    end.

%%--------------------------------------------------------------------
%% @spec is_equal(string()) -> bool()
%%
%% @doc Match = character at the head of string.
%% @end
%%--------------------------------------------------------------------
is_equal([$=|Rest]) ->
    {true, Rest};
is_equal(_) ->
    false.

%%--------------------------------------------------------------------
%% @spec is_amp(string()) -> bool()
%%
%% @doc Match &amp; character or &amp;amp; entity at the beginning of string.
%% @end
%%--------------------------------------------------------------------
is_amp("&amp;"++Rest) ->
    {true, Rest};
is_amp([$&|Rest]) ->
    {true, Rest};
is_amp(_) ->
    false.


%%--------------------------------------------------------------------
%% @spec unquote(string()) -> string()
%%
%% @doc URL decodes the given term. 
%% Used to parse query strings and application/x-www-form-urlencoded data. 
%% @end
%%--------------------------------------------------------------------
unquote(Val) when is_binary(Val) ->
    unquote(binary_to_list(Val), []);
unquote(Val) ->
    unquote(Val, []).

unquote([], Acc) ->
    lists:reverse(Acc);
unquote([37, Hi, Lo|Rest], Acc) -> % match %Hex 
    unquote(Rest, [(from_hex(Lo) bor (from_hex(Hi) bsl 4))|Acc]);
unquote([$+|Rest], Acc) ->
    unquote(Rest, [$\s|Acc]);
unquote([H|Rest], Acc) ->
    unquote(Rest, [H|Acc]).

%%--------------------------------------------------------------------
%% @spec to_hex(char()) -> hex()
%%
%% @doc convert char to hex code.
%% @end
%%--------------------------------------------------------------------
to_hex(C) when C < 10 -> $0 + C;
to_hex(C) when C < 16 -> $A + (C - 10).

%%--------------------------------------------------------------------
%% @spec from_hex(hex()) -> char()
%%
%% @doc Used to get char from hex code.
%% @end
%%--------------------------------------------------------------------
from_hex(C) when C >= $0, C =< $9 -> C - $0;
from_hex(C) when C >= $a, C =< $f -> C - $a + 10;
from_hex(C) when C >= $A, C =< $F -> C - $A + 10.

%%--------------------------------------------------------------------
%% @spec join([string()], Sep::string()) -> string()
%%
%% @doc Joins a list of elements using a separator. 
%% The result is reversed for efficiecy.
%% @end
%%--------------------------------------------------------------------
join(Strings, Sep) ->
    join(Strings, Sep, []).

join([], _Sep, _Acc) ->
    [];
join([Last], _Sep, Acc) ->
    [Last|Acc];
join([H|Rest], Sep, Acc) ->
    join(Rest, Sep, [Sep, H|Acc]).

nhdr(L) when is_atom(L) ->
    nhdr(atom_to_list(L));
nhdr(L) when is_binary(L) ->
    nhdr(binary_to_list(L));
nhdr(L) when is_list(L) ->
    underscoreize(L, []).

underscoreize([], S) ->
    lists:reverse(S);
underscoreize([$-|T], S) ->
    underscoreize(T, [$_|S]);
underscoreize([H|T], S) ->
    underscoreize(T, [H|S]).

normalize_header({K, V}) ->
    {string:to_upper(string:strip(nhdr(K))), string:strip(V)}.

%% http://www.w3.org/Protocols/rfc2616/rfc2616-sec5.html#sec5.1.2
%% and
%% http://www.ietf.org/rfc/rfc2396.txt, sec 2.4.2
unquote_path(Path) ->
    PathComponents = [unquote(X) || X <- path_components(Path, [], [])],
    lists:flatten(join(PathComponents, "%2F")).

path_components([], Piece, Acc) ->
    [lists:reverse(Piece)|Acc];
path_components("%2f" ++ Rest, Piece, Acc) ->
    path_components(Rest, [], [lists:reverse(Piece)|Acc]);
path_components("%2F" ++ Rest, Piece, Acc) ->
    path_components(Rest, [], [lists:reverse(Piece)|Acc]);
path_components([C|Rest], Piece, Acc) ->
    path_components(Rest, [C|Piece], Acc).
